home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb34.arc / KBMTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1986-02-10  |  3KB  |  97 lines
  1. program TestKeyboardMouse;
  2.  
  3. { This Turbo Pascal program illustrates how to use the KB Mouse
  4.   bit flags in an application.
  5.  
  6.   KBM.COM must be executed before running this program.         }
  7.  
  8. const
  9.     KeyBits  = $4f0;
  10.     ContFlag = $4f1;
  11.     InstFlag = $4f2;
  12. var
  13.     x, y, k  : byte;
  14.     AStr     : char;
  15.  
  16. Procedure CheckIfKBMInstalled;
  17. begin
  18.     if (Memw[$0000:InstFlag] <> $1234) then begin
  19.          Write(^G,'KBM has not been installed!');
  20.          Halt;
  21.     end;
  22. end; { Procedure check if KBM installed }
  23.  
  24. procedure SetCursor(TopLine, BotLine : byte);
  25. type
  26.     Regs = record
  27.               ax, bx, cx, dx, bp, si, di, ds, es, flags : integer;
  28.            end;
  29. var
  30.     R    : Regs;
  31. begin
  32.     r.ax:=1 shl 8 + 0;
  33.     r.cx:=TopLine shl 8 + BotLine;
  34.     intr($10,R);
  35. end; { Procedure set cursor lines }
  36.  
  37. Procedure Setup;
  38. begin
  39.     CheckIfKBMInstalled;
  40.     Mem[$0000:ContFlag]:=1;       { kb mouse keys will NOT be read as
  41.                                     normal keystrokes! }
  42.     X:=40; Y:=12; AStr:=' ';
  43.     TextMode; ClrScr;
  44.     SetCursor(0,15);              { use a large cursor for kb mouse pointer }
  45.     WriteLn('Use arrow keys to move the cursor');
  46.     WriteLn('[Home] [PgUp] and [-] are mouse ''buttons''');
  47.     WriteLn('Press [CapsLock] to accelerate');
  48.     WriteLn('Press [Esc] to exit the loop');
  49. end; { Procedure setup }
  50.  
  51. Procedure Exit;
  52. begin
  53.     Mem[$0000:ContFlag]:=0;  { Reset to normal key processing }
  54.     SetCursor(10,11);        { Reset to normal cursor }
  55. end; { Procedure exit }
  56.  
  57. Procedure MoveCursorAndSenseKBMButtons;
  58. var
  59.     CapsLock  : boolean;
  60. begin
  61.     Repeat
  62.          GotoXY(x,y);             { move cursor to new position }
  63.          k:=Mem[$0000:KeyBits];   { read the bit flags for the kb mouse }
  64.  
  65.          CapsLock:=(k and 128) <> 0;
  66.          if CapsLock then Delay(25)     { Short delay }
  67.                      else Delay(50);    { Longer delay }
  68.          if CapsLock then k:=k xor 128; { Clear capslock bit }
  69.  
  70.          case K of  { Move cursor pointer, if necessary }
  71.               1 : { up }    y:=y-1;
  72.               2 : { right } x:=x+1;
  73.               4 : { down }  y:=y+1;
  74.               8 : { left }  x:=x-1;
  75.          end;
  76.  
  77.          if (x>80) then x:=1 else if (x<1) then x:=80; { Adjust cursor to }
  78.          if (y>24) then y:=1 else if (Y<1) then y:=24; {  wrap around screen }
  79.  
  80.          case K of { Read mouse buttons, react appropriately }
  81.               16 : { Button 1 = [Home] } begin
  82.                    Sound(200); Delay(100); NoSound; end;
  83.               32 : { Button 2 = [PgUp] } begin
  84.                    Sound(400); Delay(100); NoSound; end;
  85.               64 : { Button 3 = [-] (grey minus) } begin
  86.                    Sound(600); Delay(100); NoSound; end;
  87.          end;
  88.  
  89.          if KeyPressed then Read(kbd,AStr);
  90.     until (AStr=#27); { Exit loop on [Esc] }
  91. end; { Procedure move cursor and sense KBM buttons }
  92.  
  93. BEGIN
  94.     Setup;
  95.     MoveCursorAndSenseKBMButtons;
  96.     Exit;
  97. END. { program Test keyboard mouse }